perm filename SCHART.LSP[TIM,LSP]2 blob
sn#768067 filedate 1984-09-05 generic text, type C, neo UTF8
COMMENT ā VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 Chart Making program for TEX output.
C00006 00003 The lines of a box are segments. So a Box would look like:
C00009 00004 (do-schart-real 'tak)
C00023 ENDMK
Cā;
;;; Chart Making program for TEX output.
;;; This is for making charts which are sorted best to worst, and
;;; possibly normalized. You can report CPU or REAL time.
;;;
;;; For each benchmark:
;;;(...(benchmark
;;; ((blankline))
;;; ((indent 1) "Benchmark 3" (entry (f entry)))
;;; ((center) "Random Text"))...)
;;;
;;; For each implementation:
;;;(...(impl "Top-row Information")...)
(declare (special *data* *benchmarks* *all-implementations* *normalize*
*all-implementations-flattened* *max-length*
*selectors* *subset-relationships* *all-benchmarks* *leave-outs*))
(sstatus syntax #o45 (status syntax #o40))
(declare (mapex t))
(setq *normalize* ())
(setq *max-length* ())
(setq *leave-outs* '(franz780yy franz780ny franz780nn s3600fpa
franz750yy franz750ny franz750nn
franz68kyy franz68kny franz68knn))
(declare (special *benchmark-info*))
(defun get-bench-data (bench)
(cdr (assoc bench *data*)))
(defun get-bench-entry (impl full-entry)
(cadr (assoc impl full-entry)))
(defmacro trunc (x)
`(//$
(float
(fix
(times 100.0 ,x))) 100.0))
(defun tsafe-quotient (x y)
(cond ((and (numberp x)
(numberp y))
(cond ((and (zerop x)(zerop y))
1.0)
((zerop y) '"$\infty$")
(t (round (quotient x y)))))))
(defmacro lookup-fun (impl type)
`(cadr (assq ,type (cadr (assq ,impl *selectors*)))))
(defun cadr-lessp (x y)
(let ((q (cadr x))
(r (cadr y)))
(cond ((numberp q)
(cond ((numberp r)
(lessp q r))
(t t)))
(t ()))))
(defmacro infinity-ize (x)
`(let ((x ,x))
(cond ((numberp x)
x)
((eq x 'ā)
"$\infty$"))))
(defun filter-out (l leave-outs)
(mapcan #'(lambda (x)
(cond ((memq (car x)
leave-outs)
())
(t (ncons x))))
l))
(defun truncate-list (l len)
(cond ((and (numberp len)
(lessp 0 len))
(mapcan #'(lambda (x)
(cond ((zerop len) ())
(t (setq len (sub1 len))
(ncons x))))
l))
(t l))))
;;; The lines of a box are segments. So a Box would look like:
;;; <blankline>
;;; Division by 2
;;; <blankline>
;;; Recursive
;;; Iterative
;;; <blankline>
(defun make-a-chart (full-benchmark benchmark entry-fun type)
(princ "&&\hfil {\bf Implementation}\hfil&&")
(cond ((eq type 'cpu)
(princ "{\bf CPU}&\cr\tablerule"))
(t
(princ "{\bf REAL}&\cr\tablerule")))
(make-rows full-benchmark benchmark entry-fun type)
t)
(defun make-rows (full-benchmark benchmark entry-fun type)
(let ((info
(get-bench-data full-benchmark)))
(let ((data
(mapcar
#'(lambda (impl)
(let ((entry (caddr impl)))
(list (car entry)
(let ((stuff
(funcall entry-fun
(get-bench-entry
(cadr impl)
info)))
(fun (lookup-fun benchmark
type)))
(and fun stuff
(funcall fun (car impl) stuff))))))
(filter-out *all-implementations-flattened* *leave-outs*))))
(setq data
(truncate-list (sort data #'cadr-lessp) *max-length*))
(do ((data data (cdr data))
(best (cadr (car data))))
((null data) t)
(let ((impl-entry (car data)))
(terpri)
(princ "&&")
(princ (car impl-entry))
(princ "&&")
(cond ((null (cadr impl-entry)))
(t
(cond (*normalize*
(princ (infinity-ize (safe-quotient
(cadr impl-entry)
best))))
(t (princ (trunc (cadr impl-entry)))))))
(princ "&\cr\tablerule")
(terpri))))))
;;; (do-schart-real 'tak)
;;; (do-schart-cpu 'traverse)
;;; (do-schart-real 'traverse-init)
;;; Look at *all-benchmarks* in DATA.BCH[TIM,LSP] to see the options.
(defun do-schart-real (benchmark)
(let ((entry (cdr (assq benchmark *subset-relationships*))))
(terpri)
(princ "\newbox\bigstrutbox")
(terpri)
(princ "\setbox\bigstrutbox=\hbox{\vrule height8.6pt depth3.6pt width0pt}")
(terpri)
(princ "\def\bigstrut{\relax\ifmmode\copy\bigstrutbox\else\unhcopy\bigstrutbox\fi}")
(terpri)
(cond (entry
(mapc #'(lambda (x) (do-schart1 benchmark x 'real)
(terpri)
(princ "\vfill\eject")
(terpri))(car entry)))
(t (do-schart1 benchmark benchmark 'real)))
t)))
(defun do-schart-cpu (benchmark)
(let ((entry (cdr (assq benchmark *subset-relationships*))))
(terpri)
(princ "\newbox\bigstrutbox")
(terpri)
(princ "\setbox\bigstrutbox=\hbox{\vrule height10pt depth5.0pt width0pt}")
(terpri)
(princ "\def\bigstrut{\relax\ifmmode\copy\bigstrutbox\else\unhcopy\bigstrutbox\fi}")
(terpri)
(cond (entry
(mapc #'(lambda (x) (do-schart1 benchmark x 'cpu)
(terpri)
(princ "\vfill\eject")
(terpri))(car entry)))
(t (do-schart1 benchmark benchmark 'cpu)))
t)))
(defun do-schart1 (full-benchmark benchmark type)
(let ((n 1)(entry (cdr (assq benchmark *all-benchmarks*))))
(princ "$$\vbox{\tabskip=0pt \offinterlineskip")
(terpri)
(princ "\def\tablerule{\noalign{\hrule}}")
(terpri)
(princ "\halign {\bigstrut#& \vrule#\tabskip=1em plus2em& \vrule#&")
(do ((i (1- n) (1- i)))
((zerop i)
(princ "\hfil#\hfil& \vrule#\tabskip=0pt\cr\tablerule")
(terpri)
(princ "&&\multispan{")(princ (1+ (* n 2)))
(princ "}\hfil ")
(cond ((eq type 'real)
(princ "{\bf Real Time}"))
(t
(princ "{\bf CPU Time}")))
(cond (*normalize*
(princ " {\bf (Normalized)}")))
(princ "\hfil&\cr")
(terpri)
(princ "&&\multispan{")(princ (1+ (* n 2)))
(princ "}{\hfil {\bf ")(princ (car entry))
(princ "}}\hfil&\cr\tablerule")
(terpri)
)
(princ "\hfil#\hfil& \vrule#&")(terpri))
(make-a-chart
full-benchmark benchmark
(cadr entry) type)
(princ "}}$$")))